home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / KESMECE.BAS < prev    next >
Encoding:
BASIC Source File  |  1980-01-10  |  10.1 KB  |  334 lines
  1. DECLARE SUB Yardim ()
  2. DECLARE SUB Bekle ()
  3. DECLARE SUB Bellek (A%)
  4. DECLARE SUB Bitir ()
  5. DECLARE SUB Cizgi ()
  6. DECLARE SUB DusmanCiz ()
  7. DECLARE SUB Hata (A$)
  8. DECLARE SUB iptal (A%)
  9. DECLARE SUB isimal ()
  10. DECLARE SUB Oyna ()
  11. DECLARE SUB Puanlist ()
  12. DECLARE FUNCTION RenkKontrol% (Dusyer%())
  13. DECLARE FUNCTION Tus% ()
  14. DECLARE SUB Tusunut ()
  15. DEFINT A-Z
  16. DECLARE FUNCTION GetCS% ()
  17. DECLARE FUNCTION GetOF% ()
  18. DECLARE SUB Resmet (BYVAL B%, C%)
  19. DECLARE SUB Resim ()
  20. DECLARE SUB Font ()
  21. DECLARE SUB Dinle (BYVAL Segm%)
  22. DECLARE SUB Dinle2 (BYVAL Segm%)
  23. DECLARE SUB YavasKapa ()
  24. DECLARE SUB Kapa ()
  25. '===========================================================================
  26. 'Sabitler
  27. CONST Zemin = 2, Kutu = 223, Cizim = 254, Boya = 40, icKutu = 222
  28. CONST Dusman = 253, Punto = 4
  29. CONST OyunHizi = 1
  30. '===========================================================================
  31. 'Deºiƒkenler
  32. TYPE RegTypeX
  33.      Ax    AS INTEGER
  34.      Bx    AS INTEGER
  35.      Cx    AS INTEGER
  36.      Dx    AS INTEGER
  37.      bp    AS INTEGER
  38.      si    AS INTEGER
  39.      di    AS INTEGER
  40.      Flags AS INTEGER
  41.      Ds    AS INTEGER
  42.      Es    AS INTEGER
  43. END TYPE
  44. DIM SHARED yap AS RegTypeX
  45. DIM SHARED Yatay, Dikey, Yatay1, Dikey1
  46. DIM SHARED Aktif, Yol$, Zaman#
  47. DIM SHARED Puan(10), Puan$(10)
  48. DIM SHARED Dusyer(10), Hayat, Dudak(330)
  49. DIM SHARED Player%
  50. '===========================================================================
  51. 'Program
  52. CALL Bellek(2720): Player% = yap.Ax
  53. SCREEN 13
  54. ON ERROR GOTO Hatalar
  55. Resim
  56. Font
  57. DO
  58.    Dinle Player%
  59.    Puanlist
  60.    Kapa
  61.    Dinle2 Player%
  62.    Oyna
  63.    isimal
  64.    Kapa
  65. LOOP
  66.  
  67. Hatalar:
  68. Hata ("Disketin korumasìnì kaldìrìn...")
  69.  
  70. SUB Bekle
  71.    DEF SEG = 0
  72.      IF PEEK(1052) > PEEK(1050) + 15 THEN POKE 1050, PEEK(1052)
  73.      z = PEEK(1132)
  74.    DO
  75.       IF PEEK(1132) - z = OyunHizi OR z > PEEK(1132) THEN EXIT DO
  76.    LOOP
  77. END SUB
  78.  
  79. SUB Bellek (A%)
  80.     Bos& = SETMEM(-1 * (A% + 17))
  81.     yap.Ax = &H4800: yap.Bx = A% \ 16 + 1
  82.     CALL Interruptx(&H21, yap, yap)
  83.     IF (yap.Flags AND 1) THEN PRINT "Hata": END
  84. END SUB
  85.  
  86. SUB Bitir
  87.       CLS
  88.       YavasKapa
  89.       Yer = -1
  90.       FOR i = 182 TO 13 STEP -1
  91.            Yer = Yer + 1: B% = 800 + (Yer) * 180: C% = i * 320
  92.            CALL Resmet(B%, C%): IF i / 10 = i \ 10 THEN Bekle
  93.       NEXT
  94.       FOR i = 1 TO 30: Bekle: NEXT
  95.       Kapa
  96.       END
  97. END SUB
  98.  
  99. SUB Cizgi
  100.     SELECT CASE POINT(Yatay, Dikey)
  101.  
  102.        CASE Zemin, Cizim, Punto
  103.          PSET (Yatay1, Dikey1), Punto
  104.          IF Aktif = 0 THEN Yol$ = Yol$ + CHR$(Yatay1) + CHR$(Dikey1)
  105.          IF POINT(Yatay, Dikey) = Zemin THEN Aktif = 1
  106.  
  107.        CASE icKutu
  108.          PSET (Yatay1, Dikey1), icKutu
  109.          IF Aktif = 1 THEN
  110.               iptal (icKutu)
  111.               PAINT (Dusyer(1), Dusyer(2)), Kutu, icKutu
  112.               PAINT (12, 12), Boya, Kutu
  113.               PAINT (Dusyer(1), Dusyer(2)), Zemin, Boya
  114.               LINE (11, 11)-(195, 185), Zemin, B
  115.               PAINT (12, 12), icKutu, Zemin
  116.               LINE (11, 11)-(195, 185), Kutu, B
  117.             Puan(0) = 0
  118.             FOR i = 13 TO 182
  119.                B% = 800 + (i - 13) * 180: C% = i * 320
  120.                CALL Resmet(B%, C%): Puan(0) = Puan(0) + C%
  121.             NEXT
  122.             IF POINT(Yatay, Dikey) <> icKutu THEN
  123.                FOR i = Dusyer(1) TO 193
  124.                   IF POINT(i, Dusyer(2)) = icKutu THEN Yatay = i: Dikey = Dusyer(2): EXIT FOR
  125.                NEXT
  126.             END IF
  127.             Tusunut
  128.          END IF
  129.        CASE ELSE
  130.          Yatay = Yatay1: Dikey = Dikey1
  131.  
  132.     END SELECT
  133.  
  134.     IF Aktif = 1 THEN
  135.        Yol$ = Yol$ + CHR$(Yatay) + CHR$(Dikey)
  136.        PSET (Yatay, Dikey), Cizim
  137.     ELSE
  138.        PSET (Yatay, Dikey), 0
  139.     END IF
  140.     Yatay1 = Yatay: Dikey1 = Dikey
  141. END SUB
  142.  
  143. SUB DusmanCiz
  144.       IF Aktif = 1 THEN
  145.          IF Yatay < Dusyer(1) + 2 THEN Dusyer(3) = -2:  ELSE Dusyer(3) = 2
  146.          IF Dikey < Dusyer(2) + 2 THEN Dusyer(4) = -2:  ELSE Dusyer(4) = 2
  147.       END IF
  148.  
  149.       A = RND * 164
  150.       IF A < 2 THEN Dusyer(3) = Dusyer(3) * -1: Dusyer(4) = Dusyer(4) * -1
  151.       Dusyer(6) = Dusyer(1): Dusyer(7) = Dusyer(2)
  152.       A = RND * 11
  153.       IF A < 5 THEN Dusyer(1) = Dusyer(1) + Dusyer(3) ELSE Dusyer(2) = Dusyer(2) + Dusyer(4)
  154.  
  155.       Renk = RenkKontrol(Dusyer())
  156.  
  157.       IF Renk <> -1 THEN
  158.         LINE (Dusyer(6), Dusyer(7))-(Dusyer(6) + 22, Dusyer(7) + 13), Zemin, BF
  159.         PUT (Dusyer(1), Dusyer(2)), Dudak, PSET: Bekle
  160.       ELSE
  161.         Dusyer(3) = Dusyer(3) * -1: Dusyer(4) = Dusyer(4) * -1
  162.         Dusyer(1) = Dusyer(6): Dusyer(2) = Dusyer(7)
  163.       END IF
  164.  
  165. END SUB
  166.  
  167. SUB Hata (A$)
  168.     COLOR 40: CLS : PRINT A$:  YavasKapa: FOR i = 1 TO 30: Bekle: NEXT: Kapa
  169.     END
  170. END SUB
  171.  
  172. SUB iptal (A%)
  173.      FOR i = LEN(Yol$) TO 2 STEP -2
  174.         PSET (ASC(MID$(Yol$, i - 1, 1)), ASC(MID$(Yol$, i, 1))), A%
  175.      NEXT
  176.      Yol$ = "": Aktif = 0
  177. END SUB
  178.  
  179. SUB isimal
  180.   IF Puan(10) >= Puan(0) THEN EXIT SUB
  181.   Puan$(0) = SPACE$(25)
  182.   B$ = STR$(Puan(0)): MID$(Puan$((0)), 26 - LEN(B$), LEN(B$)) = B$
  183.  
  184.   FOR i = 1 TO 10
  185.   FOR n = 0 TO 9
  186.      B = VAL(RIGHT$(Puan$(i), 5)): C = VAL(RIGHT$(Puan$(n), 5))
  187.      IF C < B THEN SWAP Puan$(i), Puan$(n)
  188.   NEXT: NEXT
  189.  
  190.      COLOR 4: CLS
  191.      FOR i = 0 TO 9
  192.         IF VAL(RIGHT$(Puan$(i), 5)) = Puan(0) THEN isimY = i
  193.         LOCATE , 2: PRINT i + 1; : LOCATE , 7: PRINT Puan$(i)
  194.      NEXT
  195.  
  196.      Y = 1
  197.   DO
  198.      COLOR 40: LOCATE isimY + 1, 7: PRINT Puan$(isimY); : COLOR 8: LOCATE , 6 + Y: PRINT "■"
  199.      A$ = INKEY$
  200.      IF A$ <> "" AND LEN(A$) = 1 THEN
  201.         LOCATE isimY + 1, 6 + Y: PRINT " "
  202.         IF ASC(A$) = 8 AND Y > 1 THEN MID$(Puan$(isimY), Y, 1) = " ": Y = Y - 1
  203.         IF ASC(A$) = 27 THEN EXIT SUB
  204.         IF ASC(A$) = 13 THEN EXIT DO
  205.         IF ASC(A$) > 27 THEN MID$(Puan$(isimY), Y, 1) = A$: Y = Y + 1: IF Y > 18 THEN Y = 18
  206.      END IF
  207.   LOOP
  208.  
  209.      A$ = "": FOR i = 1 TO 10: A$ = A$ + Puan$(i - 1): NEXT
  210.      FOR i = 1 TO 250
  211.         Kontrol# = Kontrol# + i * ASC(MID$(A$, i, 1))
  212.      NEXT
  213.      PUT #1, 1, A$: PUT #1, , Kontrol#
  214. END SUB
  215.  
  216. SUB Oyna
  217.      COLOR 4: CLS
  218.      FOR Y = 66 TO 79
  219.      FOR i = 76 TO 98
  220.            DEF SEG = GetCS: B = PEEK(GetOF + 801 + i + Y * 180)
  221.            DEF SEG = &HA000: POKE Y * 320 + i, B
  222.      NEXT: NEXT
  223.      GET (76, 66)-(98, 79), Dudak
  224.      LINE (11, 11)-(194, 184), Kutu, B: LINE (12, 12)-(193, 183), Zemin, BF: LINE (13, 13)-(192, 182), icKutu, B
  225.      COLOR 1: LOCATE 2, 26: PRINT "Puan:": LOCATE 3, 26: PRINT "Oyuncu :": LOCATE 4, 26: PRINT "Süre:": LOCATE 7, 26: PRINT "Müzik:": LOCATE 10, 26: PRINT "Grafik:"
  226.      COLOR 8: LOCATE 11, 26: PRINT "Gürol DEMÿR": LOCATE 8, 26: PRINT "M.Doºan ÖZDEMÿR"
  227.      Yatay1 = 13: Dikey1 = 13: Yatay = 13: Dikey = 13
  228.      Dusyer(1) = 50: Dusyer(2) = 50: Dusyer(3) = 3: Dusyer(4) = 3: Hayat = 10
  229.      Puan(0) = 0
  230.      Zaman# = FIX(TIMER) + 600
  231.  
  232.      DO
  233.        IF Tus THEN EXIT DO
  234.        Cizgi
  235.        DusmanCiz
  236.        COLOR 8: LOCATE 2, 31: PRINT USING "##,###"; Puan(0)
  237.        LOCATE , 34: PRINT Hayat: IF Hayat = 0 THEN EXIT DO
  238.        IF Zaman# - FIX(TIMER) > 600 THEN Zaman# = Zaman# - 86400
  239.        LOCATE , 33: PRINT Zaman# - FIX(TIMER): IF Zaman# - FIX(TIMER) <= 0 THEN EXIT DO
  240.      LOOP
  241. END SUB
  242.  
  243. SUB Puanlist
  244.      CLOSE #1: OPEN "KESMECE.SCR" FOR BINARY AS #1
  245. Basla:
  246.      Kontrol# = 0
  247.      COLOR 4: CLS : LOCATE , 12: PRINT "Puan Listesi"
  248.         IF LOF(1) = 0 THEN A$ = SPACE$(250): PUT #1, 1, A$: Kontro# = 1004000: PUT #1, , Kontro#
  249.         A$ = SPACE$(250): GET #1, 1, A$
  250.      FOR i = 1 TO 250
  251.         Kontrol# = Kontrol# + i * ASC(MID$(A$, i, 1))
  252.      NEXT
  253.      GET #1, , Kontro#
  254.      IF Kontro# <> Kontrol# THEN Hata ("Puan listesi karìƒtìrìlm샠!!!")
  255.      Yer = 0
  256.      FOR i = 1 TO 250 STEP 25
  257.         A$ = SPACE$(25): GET #1, i, A$: Yer = Yer + 1
  258.         LOCATE , 2: PRINT Yer; : LOCATE , 7: PRINT A$
  259.         Puan(Yer) = VAL(RIGHT$(A$, 5)): Puan$(Yer) = A$
  260.      NEXT
  261.      LOCATE , 6: PRINT "Esc)Bitir  Enter)Oyna   F1)Yardìm"
  262.      KEY 1, CHR$(255)
  263.      DO
  264.         DO: A$ = INKEY$: LOOP UNTIL A$ <> ""
  265.         IF ASC(A$) = 255 THEN Yardim: GOTO Basla
  266.         IF ASC(A$) = 27 THEN Bitir
  267.         IF ASC(A$) = 13 THEN EXIT DO
  268.      LOOP
  269. END SUB
  270.  
  271. FUNCTION RenkKontrol (Dusyer())
  272.     FOR i = Dusyer(1) TO Dusyer(1) + 22
  273.     FOR Y = Dusyer(2) TO Dusyer(2) + 13
  274.     SELECT CASE POINT(i, Y)
  275.        CASE Cizim, Punto
  276.             Hayat = Hayat - 1
  277.             Yatay1 = ASC(Yol$)
  278.             Dikey1 = ASC(MID$(Yol$, 2, 1))
  279.             Yatay = ASC(Yol$)
  280.             Dikey = ASC(MID$(Yol$, 2, 1))
  281.             iptal (Zemin)
  282.             PSET (Yatay, Dikey), 0
  283.             RenkKontrol = -1
  284.             Tusunut
  285.             EXIT FUNCTION
  286.        CASE icKutu, 0
  287.           RenkKontrol = -1: EXIT FUNCTION
  288.     END SELECT
  289.     NEXT: NEXT
  290. END FUNCTION
  291.  
  292. FUNCTION Tus
  293.         A$ = INKEY$
  294.         IF A$ = "" THEN EXIT FUNCTION
  295.         IF ASC(A$) = 27 THEN Tus = -1: EXIT FUNCTION
  296.         IF LEN(A$) = 2 THEN
  297.                 z = ASC(RIGHT$(A$, 1))
  298.                 SELECT CASE z
  299.                         CASE 75
  300.                           IF Yatay > 13 THEN Yatay = Yatay - 1
  301.                         CASE 77
  302.                           IF Yatay < 192 THEN Yatay = Yatay + 1
  303.                         CASE 72
  304.                           IF Dikey > 13 THEN Dikey = Dikey - 1
  305.                         CASE 80
  306.                           IF Dikey < 182 THEN Dikey = Dikey + 1
  307.                 END SELECT
  308.         END IF
  309. END FUNCTION
  310.  
  311. SUB Tusunut
  312.   DEF SEG = 0: POKE 1050, PEEK(1052)
  313.   FOR i = 1 TO 15: Bekle: NEXT
  314.   DEF SEG = 0: POKE 1050, PEEK(1052)
  315. END SUB
  316.  
  317. SUB Yardim
  318.     COLOR 40: CLS
  319.     PRINT "     Oyuna baƒlayìnca karƒìnìza bir"
  320.     PRINT "dikdörtgen gelir. Bu kutunun içinde"
  321.     PRINT "gizli bir resim vardìr.Ortadaki dudak"
  322.     PRINT "bu resmi korumaktadìr. Siz ise sol üst"
  323.     PRINT "köƒedeki hareketli nokta ile bu resmi"
  324.     PRINT "açmaya çalìƒacaksìnìz. Sìnìr çizgileri"
  325.     PRINT "içinde emniyette olursunuz. Dudak sizi"
  326.     PRINT "resmin içinde yakalarsa bir hakkìnìz"
  327.     PRINT "yanar. Cursor hareket tuƒlarì ile nokta"
  328.     PRINT "hareket eder. Resmin içine girip tekrar"
  329.     PRINT "kenara kaçmalìsìnìz....ÿyi eºlenceler..."
  330.     Bekle
  331.     DO: LOOP UNTIL INKEY$ <> ""
  332. END SUB
  333.  
  334.